home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / usenet / sources / volume90 / rexx / mrnbst.ime / MRNBSTime.vt100 < prev    next >
Text File  |  1990-03-04  |  4KB  |  179 lines
  1. /* This VT100 AREXX macro will try to get the precise time by calling the
  2. ** National Bureau of Standards. It captures the time string, then calls
  3. ** the program "MRNBSTime" with the result.
  4. **
  5. ** This macro requires VT100 R2.9 and ARexx 1.10.
  6. **/
  7. trace OFF
  8.  
  9. if show("L", "rexxsupport.library") = 0
  10. then call addlib "rexxsupport.library", 0, -30, 0
  11.  
  12. do
  13.     portname = "REXX-VT100"
  14.     port = openport(portname)
  15.  
  16.     if Port = '0000 0000'x
  17.     then do
  18.         say "Couldn't open the port."
  19.         exit 20
  20.     end
  21.  
  22.     "BAUD 1200"
  23.  
  24.     "FORWARD" portname              /* Enable forwarding of received data. */
  25.     if rc ~= 0 then exit
  26.     forwarding = 1
  27.     
  28.     if dial("DT1-202-653-0351") = 0 /* Dial NBS. */
  29.     then do 
  30.         'MSG "Dial failed."'
  31.         call cleanup 20
  32.     end
  33.  
  34.     'FORWARD'                       /* Disable forwarding of received data. */
  35.     forwarding = 0
  36.  
  37.     /* Note that this uses a file in RAM:. You might want to try using a named
  38.      * pipe (e.g. PIPE:NBSTIME) instead!
  39.      */
  40.  
  41.     "CAPTURE RAM:zzzNBSTime.text"   /* Capture time code text. */
  42.     call delay 250                  /* Collect approx. 5 seconds worth. */
  43.     "CAPTURE"                       /* Close capture buffer. */
  44.  
  45.     /* Set the system date. */
  46.     address COMMAND 'MRNBSTime -h -5 RAM:zzzNBSTime.text'
  47.  
  48.     /* Unless you have an incredibly slow disk drive, your clock should now be 
  49.      * within 1 second of the NBS time.  Don't you just feel good all over?
  50.      */
  51.  
  52.     'MSG "Ohhh...it feels so good!"'
  53.  
  54.     call cleanup -1
  55.  
  56.     /*
  57.      * Delete our temporary file.
  58.      */
  59.     address COMMAND 'Delete RAM:zzzNBSTime.text'
  60.  
  61. end
  62.  
  63. exit 0
  64.  
  65.  
  66. /*   Dial the specified number(s).  If we get no connection we keep going till
  67. ** we get a connection.  If we never get one then we return 0 for failure else
  68. ** we return 1 for success.
  69. **/
  70. dial: procedure expose port portname
  71. numargs = arg()
  72.  
  73. msgdata = ""
  74. do i = 1 to numargs
  75.     'SEND "AT' || arg(i) || '^M"'
  76.     if get_match(60, "CONNECT", "BUSY", "NO") = 2
  77.     then leave
  78. end
  79.  
  80. if i > numargs
  81. then return 0    /* Failure */
  82. else return 1    /* Success */
  83.  
  84. /*   Get a match from the serial port via VT100.  1st arg is the maximum time
  85. ** we'll wait; subsequent args are "acceptable" match strings.  We return the
  86. ** arg() index of the matched string so if we ever time out we'll return 1
  87. ** (since that's the index of the max time arg).
  88. **/
  89. get_match: procedure expose port portname
  90. numargs = arg()
  91. longest = 0
  92. do i = 2 to numargs
  93.     longest = max(longest, length(arg(i)))
  94. end
  95.  
  96. msgdata = ""
  97. maxtime = arg(1)
  98. do forever
  99.     msg = receive(maxtime)
  100.     if msg == ""
  101.     then return 1
  102.  
  103.     msgdata = msgdata || msg
  104.     do i = 2 to numargs
  105.         ndx = index(msgdata, arg(i))
  106.         if ndx > 0
  107.         then leave
  108.     end
  109.     if i <= numargs
  110.     then return i
  111.  
  112.     if length(msgdata) > longest
  113.     then msgdata = right(msgdata, longest - 1)
  114. end
  115.  
  116.  
  117. /* Don't use the AREXX waitpkt() function as that locks us up until something
  118. ** arrives at the port.  Instead, use the AmigaDOS WAIT command or, if you have
  119. ** AREXX 1.10 or later, the AREXX delay() function.
  120. **/
  121. receive: procedure expose port portname
  122. arg waittime
  123.  
  124. time = 0
  125. packet = getpkt(portname)
  126. do while packet = '0000 0000'x
  127.     if waittime ~= 0
  128.     then do
  129.         if time > waittime
  130.         then return ""
  131. /*        address COMMAND "WAIT 1 SEC"    /* AmigaDOS */ */
  132.         call delay 50                    /* AREXX 1.10 or above */
  133.         time = time + 1
  134.     end
  135.     else call waitpkt portname
  136.     packet = getpkt(portname)
  137. end
  138. msg = getarg(packet)
  139. call reply packet, 0
  140.  
  141. retval = ""
  142. do while length(msg) > 0
  143.     parse var msg first '00'x msg
  144.     retval = retval || first
  145. end
  146.  
  147. return retval
  148.  
  149. cleanup: procedure expose port portname forwarding
  150. arg retc
  151.  
  152. if forwarding = 1 then 'FORWARD'       /* Disable forwarding. */
  153.  
  154. /* Reply all packets queued up for us. */
  155.  
  156. packet = getpkt(portname)
  157. do while packet ~= '0000 0000'x
  158.     call reply packet, 0
  159.     packet = getpkt(portname)
  160. end
  161.  
  162. /* This is the hangup code. Ick! Well, it does seem to work :-| */
  163.  
  164. call delay 50
  165. 'SEND "+++"'            /* Put modem in command mode. */
  166. call delay 50
  167. 'SEND "+++"'            /* Pay the insurance man. */
  168. call delay 50
  169. 'SEND "ATH^M"'          /* Drop carrier. */
  170. call delay 50
  171. 'SEND "ATH^M"'          /* Did you hear me? I said DROP CARRIER! */
  172.  
  173. call closeport port
  174.  
  175. if retc = -1 then return
  176.  
  177. exit retc
  178.  
  179.